home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Turnbull China Bikeride
/
Turnbull China Bikeride - Disc 2.iso
/
STUTTGART
/
LANG
/
ADA
/
GNAT
/
!gcc
/
adainc
/
2
/
adb
/
a-teioed
< prev
next >
Wrap
Text File
|
1996-02-12
|
68KB
|
1,823 lines
------------------------------------------------------------------------------
-- --
-- GNAT RUNTIME COMPONENTS --
-- --
-- A D A . T E X T _ I O . E D I T I N G --
-- --
-- B o d y --
-- --
-- $Revision: 1.6 $ --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
-- ware Foundation; either version 2, or (at your option) any later ver- --
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
-- for more details. You should have received a copy of the GNU General --
-- Public License distributed with GNAT; see file COPYING. If not, write --
-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
-- MA 02111-1307, USA. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
-- --
------------------------------------------------------------------------------
with Ada.Strings.Fixed;
package body Ada.Text_IO.Editing is
function Parse_Number_String (Str : String) return Number_Attributes is
-- Changes
-- RIE 08/19/94 Fix 0.0007 as 7.0000 bug.
Answer : Number_Attributes;
begin
for I in Str'Range loop
case Str (I) is
when ' ' =>
null; -- ignore
when '1' .. '9' => -- decide if this is the start of a number.
-- if so, figure out which one...
if Answer.Has_Fraction then
Answer.End_Of_Fraction := I;
else
if Answer.Start_Of_Int = Invalid_Position then
-- start integer
Answer.Start_Of_Int := I;
end if;
Answer.End_Of_Int := I;
end if;
when '0' =>
if not Answer.Has_Fraction then
if Answer.Start_Of_Int /= Invalid_Position then
Answer.End_Of_Int := I;
end if;
end if;
-- Only count a zero before the decimal point if it follows a
-- non-zero digit. After the decimal point, zeros will be
-- counted if followed by a non-zero digit.
when '-' => -- set negative
Answer.Negative := True;
when '.' => -- close integer, start fraction
if Answer.Has_Fraction then
raise Picture_Error;
end if;
-- Two decimal points is a no-no.
Answer.Has_Fraction := True;
Answer.End_Of_Fraction := I;
-- Could leave this at Invalid_Position, but this seems the
-- right way to indicate a null range...
Answer.Start_Of_Fraction := I + 1;
Answer.End_Of_Int := I - 1;
when others =>
raise Picture_Error; -- Never Happen?
end case;
end loop;
if Answer.Start_Of_Int = Invalid_Position then
Answer.Start_Of_Int := Answer.End_Of_Int + 1;
end if;
-- no significant (intger) digits needs a null range.
return Answer;
end Parse_Number_String;
procedure Precalculate (Pic : in out Format_Record) is
Computed_BWZ : Boolean := True;
Debug : Boolean := False;
-- Am I finished at Last?
type Legality is (Okay, Reject);
State : Legality := Reject;
-- Start in reject, which will reject null strings.
Index : Pic_Index := Pic.Picture.Expanded'First;
function At_End return Boolean;
procedure Set_State (L : Legality);
function Look return Character;
function Is_Insert return Boolean;
procedure Skip;
procedure Debug_Start (Name : String);
procedure Debug_Integer (Value : in Integer; S : String);
procedure Trailing_Currency;
procedure Trailing_Bracket;
procedure Number_Fraction;
procedure Number_Completion;
procedure Number_Fraction_Or_Bracket;
procedure Number_Fraction_Or_Z_Fill;
procedure Zero_Suppression;
procedure Floating_Bracket;
procedure Number_Fraction_Or_Star_Fill;
procedure Star_Suppression;
procedure Number_Fraction_Or_Dollar;
procedure Leading_Dollar;
procedure Number_Fraction_Or_Pound;
procedure Leading_Pound;
procedure Picture;
procedure Floating_Plus;
procedure Floating_Minus;
procedure Picture_Plus;
procedure Picture_Minus;
procedure Picture_Bracket;
procedure Number;
procedure Optional_RHS_Sign;
procedure Picture_String;
function At_End return Boolean is
begin
return Index > Pic.Picture.Length;
end At_End;
pragma Inline (At_End);
procedure Set_State (L : Legality) is
begin
if Debug then
Text_IO.Put_Line (" Set state from " & Legality'Image (State) &
" to " & Legality'Image (L));
end if;
State := L;
end Set_State;
pragma Inline (Set_State);
function Look return Character is
begin
if At_End then raise Picture_Error; end if;
return Pic.Picture.Expanded (Index);
end Look;
pragma Inline (Look);
function Is_Insert return Boolean is
begin
if At_End then return False; end if;
case Pic.Picture.Expanded (Index) is
when '_' | '0' | '/' => return True;
when 'B' | 'b' =>
Pic.Picture.Expanded (Index) := 'b'; -- canonical
return True;
when others => return False;
end case;
end Is_Insert;
pragma Inline (Is_Insert);
procedure Skip is
begin
if Debug then
Text_IO.Put_Line (" Skip " & Pic.Picture.Expanded (Index));
end if;
Index := Index + 1;
end Skip;
pragma Inline (Skip);
procedure Debug_Start (Name : String) is
begin
if Debug then
Text_IO.Put_Line (" In " & Name & '.');
end if;
end Debug_Start;
pragma Inline (Debug_Start);
procedure Debug_Integer (Value : in Integer; S : String) is
use Text_IO; -- needed for >
begin
if Debug and then Value > 0 then
if Text_IO.Col > 70 - S'Length then Text_IO.New_Line; end if;
Text_IO.Put (' ' & S & Integer'Image (Value) & ',');
end if;
end Debug_Integer;
pragma Inline (Debug_Integer);
procedure Trailing_Currency is
begin
Debug_Start ("Trailing_Currency");
if At_End then return; end if;
if Look = '$' then
Pic.Start_Currency := Index;
Pic.End_Currency := Index;
Skip;
else
while not At_End and then Look = '#' loop
if Pic.Start_Currency = Invalid_Position then
Pic.Start_Currency := Index;
end if;
Pic.End_Currency := Index;
Skip;
end loop;
end if;
loop
if At_End then return; end if;
case Look is
when '_' | '0' | '/' => Skip;
when 'B' | 'b' =>
Pic.Picture.Expanded (Index) := 'b';
Skip;
when others => return;
end case;
end loop;
end Trailing_Currency;
procedure Trailing_Bracket is
begin
Debug_Start ("Trailing_Bracket");
if Look = '>' then
Pic.Second_Sign := Index;
Skip;
else raise Picture_Error;
end if;
end Trailing_Bracket;
procedure Number_Fraction is
-- Note that number fraction can be called in either State.
-- It will set state to Valid only if a 9 is encountered.
begin
Debug_Start ("Number_Fraction");
loop
if At_End then return; end if;
case Look is
when '_' | '0' | '/' => Skip;
when 'B' | 'b' =>
Pic.Picture.Expanded (Index) := 'b';
Skip;
when '9' =>
Computed_BWZ := False;
Pic.Max_Trailing_Digits := Pic.Max_Trailing_Digits + 1;
Set_State (Okay); Skip;
when others => return;
end case;
end loop;
end Number_Fraction;
procedure Number_Completion is
begin
Debug_Start ("Number_Completion");
while not At_End loop
case Look is
when '_' | '0' | '/' => Skip;
when 'B' | 'b' =>
Pic.Picture.Expanded (Index) := 'b';
Skip;
when '9' =>
Computed_BWZ := False;
Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
Set_State (Okay);
Skip;
when 'V' | 'v' | '.' =>
Pic.Radix_Position := Index;
Skip;
Number_Fraction;
return;
when others => return;
end case;
end loop;
end Number_Completion;
procedure Number_Fraction_Or_Bracket is
begin
Debug_Start ("Number_Fraction_Or_Bracket");
loop
if At_End then return; end if;
case Look is
when '_' | '0' | '/' => Skip;
when 'B' | 'b' =>
Pic.Picture.Expanded (Index) := 'b';
Skip;
when '<' =>
Pic.Max_Trailing_Digits := Pic.Max_Trailing_Digits + 1;
Pic.End_Float := Index;
Skip;
loop
if At_End then return; end if;
case Look is
when '_' | '0' | '/' => Skip;
when 'B' | 'b' =>
Pic.Picture.Expanded (Index) := 'b';
Skip;
when '<' =>
Pic.Max_Trailing_Digits :=
Pic.Max_Trailing_Digits + 1;
Pic.End_Float := Index;
Skip;
when others => return;
end case;
end loop;
when others => Number_Fraction; return;
end case;
end loop;
end Number_Fraction_Or_Bracket;
procedure Number_Fraction_Or_Z_Fill is
begin
Debug_Start ("Number_Fraction_Or_Z_Fill");
loop
if At_End then return; end if;
case Look is
when '_' | '0' | '/' => Skip;
when 'B' | 'b' =>
Pic.Picture.Expanded (Index) := 'b';
Skip;
when 'Z' | 'z' =>
Pic.Max_Trailing_Digits := Pic.Max_Trailing_Digits + 1;
Pic.End_Float := Index;
Pic.Picture.Expanded (Index) := 'Z';
-- consistancy
Skip;
loop
if At_End then return; end if;
case Look is
when '_' | '0' | '/' => Skip;
when 'B' | 'b' =>
Pic.Picture.Expanded (Index) := 'b';
Skip;
when 'Z' | 'z' =>
Pic.Picture.Expanded (Index) := 'Z';
-- consistancy
Pic.Max_Trailing_Digits :=
Pic.Max_Trailing_Digits + 1;
Pic.End_Float := Index;
Skip;
when others => return;
end case;
end loop;
when others => Number_Fraction; return;
end case;
end loop;
end Number_Fraction_Or_Z_Fill;
procedure Zero_Suppression is
begin
Debug_Start ("Zero_Suppression");
Pic.Floater := 'Z';
Pic.Start_Float := Index;
Pic.End_Float := Index;
Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
Pic.Picture.Expanded (Index) := 'Z';
-- consistancy
Skip; -- Known Z
loop
if At_End then Set_State (Okay); return; end if;
-- even a single Z is a valid picture
case Look is
when '_' | '0' | '/' =>
Pic.End_Float := Index;
Skip;
when 'B' | 'b' =>
Pic.End_Float := Index;
Pic.Picture.Expanded (Index) := 'b';
Skip;
when 'Z' | 'z' =>
Pic.Picture.Expanded (Index) := 'Z';
-- consistancy
Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
Pic.End_Float := Index;
Set_State (Okay);
Skip;
when '9' =>
Set_State (Okay);
Number_Completion;
return;
when '.' | 'V' | 'v' =>
Pic.Radix_Position := Index;
Skip; Number_Fraction_Or_Z_Fill; return;
when '#' | '$' => Trailing_Currency; Set_State (Okay); return;
when others => raise Picture_Error;
end case;
end loop;
end Zero_Suppression;
procedure Floating_Bracket is
-- Note that Floating_Bracket is only called with an acceptable
-- prefix. But we don't set Okay, because we must end with a '>'.
begin
Debug_Start ("Floating_Bracket");
Pic.Floater := '<';
Pic.End_Float := Index;
Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
-- First bracket wasn't counted...
Skip; -- known '<'
loop
if At_End then return; end if;
case Look is
when '_' | '0' | '/' =>
Pic.End_Float := Index;
Skip;
when 'B' | 'b' =>
Pic.End_Float := Index;
Pic.Picture.Expanded (Index) := 'b';
Skip;
when '<' =>
Pic.End_Float := Index;
Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
Skip;
when '9' =>
Number_Completion;
when 'V' | 'v' | '.' =>
Pic.Radix_Position := Index;
Skip; Number_Fraction_Or_Bracket; return;
when others => return;
end case;
end loop;
end Floating_Bracket;
procedure Number_Fraction_Or_Star_Fill is
begin
Debug_Start ("Number_Fraction_Or_Star_Fill");
loop
if At_End then return; end if;
case Look is
when '_' | '0' | '/' => Skip;
when 'B' | 'b' =>
Pic.Picture.Expanded (Index) := 'b';
Skip;
when '*' =>
Pic.Star_Fill := True;
Pic.Max_Trailing_Digits := Pic.Max_Trailing_Digits + 1;
Pic.End_Float := Index;
Skip;
loop
if At_End then return; end if;
case Look is
when '_' | '0' | '/' => Skip;
when 'B' | 'b' =>
Pic.Picture.Expanded (Index) := 'b';
Skip;
when '*' =>
Pic.Star_Fill := True;
Pic.Max_Trailing_Digits :=
Pic.Max_Trailing_Digits + 1;
Pic.End_Float := Index;
Skip;
when others => return;
end case;
end loop;
when others => Number_Fraction; return;
end case;
end loop;
end Number_Fraction_Or_Star_Fill;
procedure Star_Suppression is
begin
Debug_Start ("Star_Suppression");
Pic.Floater := '*';
Pic.Start_Float := Index;
Pic.End_Float := Index;
Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
Set_State (Okay);
-- even a single * is a valid picture
Pic.Star_Fill := True;
Skip; -- Known *
loop
if At_End then return; end if;
case Look is
when '_' | '0' | '/' =>
Pic.End_Float := Index;
Skip;
when 'B' | 'b' =>
Pic.End_Float := Index;
Pic.Picture.Expanded (Index) := 'b';
Skip;
when '*' =>
Pic.End_Float := Index;
Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
Set_State (Okay); Skip;
when '9' => Set_State (Okay); Number_Completion; return;
when '.' | 'V' | 'v' =>
Pic.Radix_Position := Index;
Skip; Number_Fraction_Or_Star_Fill; return;
when '#' | '$' => Trailing_Currency; Set_State (Okay); return;
when others => raise Picture_Error;
end case;
end loop;
end Star_Suppression;
procedure Number_Fraction_Or_Dollar is
begin
Debug_Start ("Number_Fraction_Or_Dollar");
loop
if At_End then return; end if;
case Look is
when '_' | '0' | '/' => Skip;
when 'B' | 'b' =>
Pic.Picture.Expanded (Index) := 'b';
Skip;
when '$' =>
Pic.Max_Trailing_Digits := Pic.Max_Trailing_Digits + 1;
Pic.End_Float := Index;
Skip;
loop
if At_End then return; end if;
case Look is
when '_' | '0' | '/' => Skip;
when 'B' | 'b' =>
Pic.Picture.Expanded (Index) := 'b';
Skip;
when '$' =>
Pic.Max_Trailing_Digits :=
Pic.Max_Trailing_Digits + 1;
Pic.End_Float := Index;
Skip;
when others => return;
end case;
end loop;
when others => Number_Fraction; return;
end case;
end loop;
end Number_Fraction_Or_Dollar;
procedure Leading_Dollar is
-- Note that Leading_Dollar can be called in either State.
-- It will set state to Okay only if a 9 or (second) $
-- is encountered.
-- Also notice the tricky bit with State and Zero_Suppression.
-- Zero_Suppression is Picture_Error if a '$' or a '9' has been
-- encountered, exactly the cases where State has been set.
begin
Debug_Start ("Leading_Dollar");
-- Treat as a floating dollar, and unwind otherwise.
Pic.Floater := '$';
Pic.Start_Currency := Index;
Pic.End_Currency := Index;
Pic.Start_Float := Index;
Pic.End_Float := Index;
-- don't increment Pic.Max_Leading_Digits, we need one "real"
-- currency place.
Skip; -- known '$'
loop
if At_End then return; end if;
case Look is
when '_' | '0' | '/' =>
Pic.End_Float := Index;
Skip;
when 'B' | 'b' =>
Pic.End_Float := Index;
Pic.Picture.Expanded (Index) := 'b';
Skip;
when 'Z' | 'z' =>
Pic.Picture.Expanded (Index) := 'Z';
-- consistancy
if State = Okay then raise Picture_Error;
else Zero_Suppression;
-- will overwrite Floater and Start_Float
end if;
when '*' =>
if State = Okay then raise Picture_Error;
else Star_Suppression;
-- will overwrite Floater and Start_Float
end if;
when '$' =>
Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
Pic.End_Float := Index;
Pic.End_Currency := Index;
Set_State (Okay); Skip;
when '9' =>
if State /= Okay then
Pic.Floater := '!';
Pic.Start_Float := Invalid_Position;
Pic.End_Float := Invalid_Position;
end if;
-- A single dollar does not a floating make.
Number_Completion;
return;
when 'V' | 'v' | '.' =>
if State /= Okay then
Pic.Floater := '!';
Pic.Start_Float := Invalid_Position;
Pic.End_Float := Invalid_Position;
end if;
-- Only one dollar before the sign is okay,
-- but doesn't float.
Pic.Radix_Position := Index;
Skip;
Number_Fraction_Or_Dollar;
return;
when others => return;
end case;
end loop;
end Leading_Dollar;
procedure Number_Fraction_Or_Pound is
begin
loop
if At_End then return; end if;
case Look is
when '_' | '0' | '/' => Skip;
when 'B' | 'b' =>
Pic.Picture.Expanded (Index) := 'b';
Skip;
when '#' =>
Pic.Max_Trailing_Digits := Pic.Max_Trailing_Digits + 1;
Pic.End_Float := Index;
Skip;
loop
if At_End then return; end if;
case Look is
when '_' | '0' | '/' => Skip;
when 'B' | 'b' =>
Pic.Picture.Expanded (Index) := 'b';
Skip;
when '#' =>
Pic.Max_Trailing_Digits :=
Pic.Max_Trailing_Digits + 1;
Pic.End_Float := Index;
Skip;
when others => return;
end case;
end loop;
when others => Number_Fraction; return;
end case;
end loop;
end Number_Fraction_Or_Pound;
procedure Leading_Pound is
-- This one is complex! A Leading_Pound can be fixed or floating,
-- but in some cases the decision has to be deferred until we leave
-- this procedure. Also note that Leading_Pound can be called in
-- either State.
-- It will set state to Okay only if a 9 or (second) # is
-- encountered.
-- One Last note : In ambiguous cases, the currency is treated as
-- floating unless there is only one '#'.
Inserts : Boolean := False;
-- set to true if a '_', '0', '/', 'B', or 'b'
-- is encountered
Must_Float : Boolean := False;
-- set to true if a '#' occurs after an
-- insert.
begin
Debug_Start ("Leading_Pound");
Pic.Floater := '#';
-- Treat as a floating currency. If it isn't, this will be
-- overwritten.
Pic.Start_Currency := Index;
Pic.End_Currency := Index;
Pic.Start_Float := Index;
Pic.End_Float := Index;
-- don't increment Pic.Max_Leading_Digits, we need one "real"
-- currency place.
Pic.Max_Currency_Digits := 1; -- we've seen one.
Skip; -- known '#'
loop
if At_End then return; end if;
case Look is
when '_' | '0' | '/' =>
Pic.End_Float := Index;
Inserts := True;
Skip;
when 'B' | 'b' =>
Pic.Picture.Expanded (Index) := 'b';
Pic.End_Float := Index;
Inserts := True;
Skip;
when 'Z' | 'z' =>
Pic.Picture.Expanded (Index) := 'Z';
-- consistancy
if Must_Float then raise Picture_Error;
else
Pic.Max_Leading_Digits := 0;
Zero_Suppression;
-- will overwrite Floater and Start_Float
end if;
when '*' =>
if Must_Float then raise Picture_Error;
else
Pic.Max_Leading_Digits := 0;
Star_Suppression;
-- will overwrite Floater and Start_Float
end if;
when '#' =>
if Inserts then Must_Float := True; end if;
Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
Pic.End_Float := Index;
Pic.End_Currency := Index;
Set_State (Okay);
Skip;
when '9' =>
if State /= Okay then
Pic.Floater := '!';
Pic.Start_Float := Invalid_Position;
Pic.End_Float := Invalid_Position;
-- a single '#' doesn't float.
end if;
Number_Completion;
return;
when 'V' | 'v' | '.' =>
if State /= Okay then
Pic.Floater := '!';
Pic.Start_Float := Invalid_Position;
Pic.End_Float := Invalid_Position;
end if;
-- Only one pound before the sign is okay,
-- but doesn't float.
Pic.Radix_Position := Index;
Skip;
Number_Fraction_Or_Pound;
return;
when others => return;
end case;
end loop;
end Leading_Pound;
procedure Picture is
-- Note that Picture can be called in either State.
-- It will set state to Valid only if a 9 is encountered or floating
-- currency is called.
begin
Debug_Start ("Picture");
loop
if At_End then return; end if;
case Look is
when '_' | '0' | '/' =>
Skip;
when 'B' | 'b' =>
Pic.Picture.Expanded (Index) := 'b';
Skip;
when '$' => Leading_Dollar; return;
when '#' => Leading_Pound; return;
when '9' =>
Computed_BWZ := False;
Set_State (Okay);
Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
Skip;
when 'V' | 'v' | '.' =>
Pic.Radix_Position := Index;
Skip;
Number_Fraction;
Trailing_Currency;
return;
when others => return;
end case;
end loop;
end Picture;
procedure Floating_Plus is
begin
Debug_Start ("Floating_Plus");
loop
if At_End then return; end if;
case Look is
when '_' | '0' | '/' =>
Pic.End_Float := Index;
Skip;
when 'B' | 'b' =>
Pic.End_Float := Index;
Pic.Picture.Expanded (Index) := 'b';
Skip;
when '+' =>
Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
Pic.End_Float := Index;
Skip;
when '9' =>
Number_Completion;
return;
when '.' | 'V' | 'v' =>
Pic.Radix_Position := Index;
Skip; -- Radix
while Is_Insert loop Skip; end loop;
if At_End then return; end if;
if Look = '+' then
loop
if At_End then return; end if;
case Look is
when '+' =>
Pic.Max_Trailing_Digits :=
Pic.Max_Trailing_Digits + 1;
Pic.End_Float := Index;
Skip;
when '_' | '0' | '/' =>
Skip;
when 'B' | 'b' =>
Pic.Picture.Expanded (Index) := 'b';
Skip;
when others => return;
end case;
end loop;
else Number_Completion;
end if;
return;
when others => return;
end case;
end loop;
end Floating_Plus;
procedure Floating_Minus is
begin
Debug_Start ("Floating_Minus");
loop
if At_End then return; end if;
case Look is
when '_' | '0' | '/' =>
Pic.End_Float := Index;
Skip;
when 'B' | 'b' =>
Pic.End_Float := Index;
Pic.Picture.Expanded (Index) := 'b';
Skip;
when '-' =>
Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
Pic.End_Float := Index;
Skip;
when '9' =>
Number_Completion;
return;
when '.' | 'V' | 'v' =>
Pic.Radix_Position := Index;
Skip; -- Radix
while Is_Insert loop Skip; end loop;
if At_End then return; end if;
if Look = '-' then
loop
if At_End then return; end if;
case Look is
when '-' =>
Pic.Max_Trailing_Digits :=
Pic.Max_Trailing_Digits + 1;
Pic.End_Float := Index;
Skip;
when '_' | '0' | '/' =>
Skip;
when 'B' | 'b' =>
Pic.Picture.Expanded (Index) := 'b';
Skip;
when others => return;
end case;
end loop;
else Number_Completion;
end if;
return;
when others => return;
end case;
end loop;
end Floating_Minus;
procedure Picture_Plus is
begin
Debug_Start ("Picture_Plus");
Pic.Sign_Position := Index;
-- Treat as a floating sign, and unwind otherwise.
Pic.Floater := '+';
Pic.Start_Float := Index;
Pic.End_Float := Index;
-- don't increment Pic.Max_Leading_Digits, we need one "real"
-- sign place.
Skip; -- Known Plus
loop
case Look is
when '_' | '0' | '/' =>
Pic.End_Float := Index;
Skip;
when 'B' | 'b' =>
Pic.End_Float := Index;
Pic.Picture.Expanded (Index) := 'b';
Skip;
when '+' =>
Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
Pic.End_Float := Index;
Skip;
Set_State (Okay); -- "++" is enough.
Floating_Plus;
Trailing_Currency;
return;
when '$' | '#' | '9' | '*' =>
if State /= Okay then
Pic.Floater := '!';
Pic.Start_Float := Invalid_Position;
Pic.End_Float := Invalid_Position;
end if;
Picture;
Set_State (Okay);
return;
when '.' | 'V' | 'v' =>
if State /= Okay then
Pic.Floater := '!';
Pic.Start_Float := Invalid_Position;
Pic.End_Float := Invalid_Position;
end if;
Picture;
-- don't assume that state is okay, haven't seen a digit.
return;
when others => return;
end case;
end loop;
end Picture_Plus;
procedure Picture_Minus is
begin
Debug_Start ("Picture_Minus");
Pic.Sign_Position := Index;
-- Treat as a floating sign, and unwind otherwise.
Pic.Floater := '-';
Pic.Start_Float := Index;
Pic.End_Float := Index;
-- don't increment Pic.Max_Leading_Digits, we need one "real"
-- sign place.
Skip; -- Known Minus
loop
case Look is
when '_' | '0' | '/' =>
Pic.End_Float := Index;
Skip;
when 'B' | 'b' =>
Pic.End_Float := Index;
Pic.Picture.Expanded (Index) := 'b';
Skip;
when '-' =>
Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
Pic.End_Float := Index;
Skip;
Set_State (Okay); -- "-- " is enough.
Floating_Minus;
Trailing_Currency;
return;
when '$' | '#' | '9' | '*' =>
if State /= Okay then
Pic.Floater := '!';
Pic.Start_Float := Invalid_Position;
Pic.End_Float := Invalid_Position;
end if;
Picture;
Set_State (Okay);
return;
when '.' | 'V' | 'v' =>
if State /= Okay then
Pic.Floater := '!';
Pic.Start_Float := Invalid_Position;
Pic.End_Float := Invalid_Position;
end if;
Picture;
-- don't assume that state is okay, haven't seen a digit.
return;
when others => return;
end case;
end loop;
end Picture_Minus;
procedure Picture_Bracket is
begin
Pic.Sign_Position := Index;
Debug_Start ("Picture_Bracket");
Pic.Sign_Position := Index;
-- Treat as a floating sign, and unwind otherwise.
Pic.Floater := '<';
Pic.Start_Float := Index;
Pic.End_Float := Index;
-- don't increment Pic.Max_Leading_Digits, we need one "real"
-- sign place.
Skip; -- Known Bracket
loop
case Look is
when '_' | '0' | '/' =>
Pic.End_Float := Index;
Skip;
when 'B' | 'b' =>
Pic.End_Float := Index;
Pic.Picture.Expanded (Index) := 'b';
Skip;
when '<' =>
Set_State (Okay); -- "<<>" is enough.
Floating_Bracket;
Trailing_Currency;
Trailing_Bracket;
return;
when '$' | '#' | '9' | '*' =>
if State /= Okay then
Pic.Floater := '!';
Pic.Start_Float := Invalid_Position;
Pic.End_Float := Invalid_Position;
end if;
Picture;
Trailing_Bracket;
Set_State (Okay);
return;
when '.' | 'V' | 'v' =>
if State /= Okay then
Pic.Floater := '!';
Pic.Start_Float := Invalid_Position;
Pic.End_Float := Invalid_Position;
end if;
Picture;
-- don't assume that state is okay, haven't seen a digit.
Trailing_Bracket;
return;
when others => raise Picture_Error;
end case;
end loop;
end Picture_Bracket;
procedure Number is
begin
Debug_Start ("Number");
loop
case Look is
when '_' | '0' | '/' => Skip;
when 'B' | 'b' =>
Pic.Picture.Expanded (Index) := 'b';
Skip;
when '9' =>
Computed_BWZ := False;
Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
Set_State (Okay);
Skip;
when '.' | 'V' | 'v' =>
Pic.Radix_Position := Index;
Skip;
Number_Fraction;
return;
when others => return;
end case;
if At_End then return; end if;
-- will return in Okay state if a '9' was seen.
end loop;
end Number;
procedure Optional_RHS_Sign is
begin
Debug_Start ("Optional_RHS_Sign");
if At_End then return; end if;
case Look is
when '+' | '-' =>
Pic.Sign_Position := Index;
Skip; return;
when 'C' | 'c' =>
Pic.Sign_Position := Index;
Pic.Picture.Expanded (Index) := 'C';
Skip;
if Look = 'R' or Look = 'r' then
Pic.Second_Sign := Index;
Pic.Picture.Expanded (Index) := 'R';
Skip;
else raise Picture_Error;
end if;
return;
when 'D' | 'd' =>
Pic.Sign_Position := Index;
Pic.Picture.Expanded (Index) := 'D';
Skip;
if Look = 'B' or Look = 'b' then
Pic.Second_Sign := Index;
Pic.Picture.Expanded (Index) := 'B';
Skip;
else raise Picture_Error;
end if;
return;
when others => return;
end case;
end Optional_RHS_Sign;
procedure Picture_String is
begin
Debug_Start ("Picture_String");
while Is_Insert loop Skip; end loop;
case Look is
when '$' | '#' =>
Picture;
Optional_RHS_Sign;
when '+' => Picture_Plus;
when '-' => Picture_Minus;
when '<' => Picture_Bracket;
when 'Z' | 'z' =>
Pic.Picture.Expanded (Index) := 'Z';
-- consistancy
Zero_Suppression;
Trailing_Currency;
Optional_RHS_Sign;
when '*' =>
Star_Suppression;
Trailing_Currency;
Optional_RHS_Sign;
when '9' | '.' | 'V' | 'v' =>
Number;
Trailing_Currency;
Optional_RHS_Sign;
when others => raise Picture_Error;
end case;
Pic.Blank_When_Zero := (Computed_BWZ or Pic.Blank_When_Zero) and not
Pic.Star_Fill;
-- Blank when zero either if the PIC does not contain a '9' or if
-- requested by the user and no '*'
Pic.Star_Fill := Pic.Star_Fill and Computed_BWZ;
-- Star fill if '*' and no '9'.
if not At_End then Set_State (Reject); end if;
end Picture_String;
begin
Picture_String;
if Debug then
Text_IO.New_Line;
Text_IO.Put (" Picture : """ &
Pic.Picture.Expanded (1 .. Pic.Picture.Length) & """,");
Text_IO.Put (" Floater : '" & Pic.Floater & "',");
end if;
if State = Reject then raise Picture_Error; end if;
Debug_Integer (Pic.Radix_Position, "Radix Positon : ");
Debug_Integer (Pic.Sign_Position, "Sign Positon : ");
Debug_Integer (Pic.Second_Sign, "Second Sign : ");
Debug_Integer (Pic.Start_Float, "Start Float : ");
Debug_Integer (Pic.End_Float, "End Float : ");
Debug_Integer (Pic.Start_Currency, "Start Currency : ");
Debug_Integer (Pic.End_Currency, "End Currency : ");
Debug_Integer (Pic.Max_Leading_Digits, "Max Leading Digits : ");
Debug_Integer (Pic.Max_Trailing_Digits, "Max Trailing Digits : ");
if Debug then Text_IO.New_Line; end if;
exception
when Constraint_Error => raise Picture_Error;
-- to deal with special cases like null strings.
end Precalculate;
function Format_Number (Pic : Format_Record;
Number : String;
Currency_Symbol : String;
Fill_Character : Character;
Separator_Character : Character;
Radix_Point : Character) return String is
-- Changes
-- RIE 08/17/94 Fix trailing 9's bug.
Attrs : Number_Attributes := Parse_Number_String (Number);
Position : Integer;
Sign_Position : Integer := Pic.Sign_Position;
-- may float.
Answer : String (1 .. Pic.Picture.Length) := Pic.Picture.Expanded;
Last : Integer;
Currency_Pos : Integer := Pic.Start_Currency;
Dollar : Boolean := False;
-- overridden immediately if necessary.
Zero : Boolean := True;
-- Set to False when a non-zero digit is output.
begin
if Pic.Start_Currency /= Invalid_Position then
Dollar := Answer (Pic.Start_Currency) = '$';
end if;
-- fix up "direct inserts" outside the playing field.
-- Set up as one loop
-- to do the beginning, one (reverse) loop to do the end.
Last := 1;
loop
exit when Last = Pic.Start_Float;
exit when Last = Pic.Radix_Position;
exit when Answer (Last) = '9';
case Answer (Last) is
when '_' =>
Answer (Last) := Separator_Character;
when 'b' =>
Answer (Last) := ' ';
when others =>
null;
end case;
exit when Last = Answer'Last;
Last := Last + 1;
end loop;
-- now for the end...
for I in reverse Last .. Answer'Last loop
exit when I = Pic.Radix_Position;
if Answer (I) = Pic.Floater then
exit;
end if;
-- do this test First, Separator_Character can equal Pic.Floater.
case Answer (I) is
when '_' =>
Answer (I) := Separator_Character;
when 'b' =>
Answer (I) := ' ';
when '9' =>
exit;
when others =>
null;
end case;
end loop;
-- non-floating sign
if Pic.Start_Currency /= -1 and then
Answer (Pic.Start_Currency) = '#' and then Pic.Floater /= '#' then
-- you would think this was a very special case... ;-)
if Currency_Symbol'Length >
Pic.End_Currency - Pic.Start_Currency + 1 then
raise Picture_Error;
elsif Currency_Symbol'Length =
Pic.End_Currency - Pic.Start_Currency + 1 then
Answer (Pic.Start_Currency .. Pic.End_Currency) :=
Currency_Symbol;
elsif Pic.Radix_Position = Invalid_Position or else
Pic.Start_Currency < Pic.Radix_Position then
Answer (Pic.Start_Currency .. Pic.End_Currency) :=
(others => ' ');
Answer (Pic.End_Currency - Currency_Symbol'Length + 1 ..
Pic.End_Currency) := Currency_Symbol;
else
Answer (Pic.Start_Currency .. Pic.End_Currency) :=
(others => ' ');
Answer (Pic.Start_Currency ..
Pic.Start_Currency + Currency_Symbol'Length - 1) :=
Currency_Symbol;
end if;
end if;
-- fill in leading digits
if Attrs.End_Of_Int - Attrs.Start_Of_Int + 1 >
Pic.Max_Leading_Digits then
raise Picture_Error;
end if;
if Pic.Radix_Position = Invalid_Position then
Position := Answer'Last;
else
Position := Pic.Radix_Position - 1;
end if;
for I in reverse Attrs.Start_Of_Int .. Attrs.End_Of_Int loop
while Answer (Position) /= '9' and Answer (Position) /= Pic.Floater
loop
if Answer (Position) = '_' then
Answer (Position) := Separator_Character;
elsif Answer (Position) = 'b' then
Answer (Position) := ' ';
end if;
Position := Position - 1;
end loop;
Answer (Position) := Number (I);
if Number (I) /= '0' then
Zero := False;
end if;
Position := Position - 1;
end loop;
-- do lead float
if Pic.Start_Float = Invalid_Position then
-- no leading floats, but need to change '9' to '0', '_' to
-- Separator_Character and 'b' to ' '.
for I in Last .. Position loop
-- Last set when fixing the "uninteresting" leaders above. Don't
-- duplicate the work.
if Answer (I) = '9' then
Answer (I) := '0';
elsif Answer (I) = '_' then
Answer (I) := Separator_Character;
elsif Answer (I) = 'b' then
Answer (I) := ' ';
end if;
end loop;
elsif Pic.Floater = '<' or else Pic.Floater = '+' or else
Pic.Floater = '-' then
for I in Pic.End_Float .. Position loop -- May be null range.
if Answer (I) = '9' then
Answer (I) := '0';
elsif Answer (I) = '_' then
Answer (I) := Separator_Character;
elsif Answer (I) = 'b' then
Answer (I) := ' ';
end if;
end loop;
if Position > Pic.End_Float then
Position := Pic.End_Float;
end if;
for I in Pic.Start_Float .. Position - 1 loop
Answer (I) := ' ';
end loop;
Answer (Position) := Pic.Floater;
Sign_Position := Position;
elsif Pic.Floater = '$' then
for I in Pic.End_Float .. Position loop -- May be null range.
if Answer (I) = '9' then
Answer (I) := '0';
elsif Answer (I) = '_' then
Answer (I) := Separator_Character;
elsif Answer (I) = 'b' then
Answer (I) := ' ';
end if;
end loop;
if Position > Pic.End_Float then
Position := Pic.End_Float;
end if;
for I in Pic.Start_Float .. Position - 1 loop
Answer (I) := ' ';
end loop;
Answer (Position) := Pic.Floater;
Currency_Pos := Position;
elsif Pic.Floater = '*' then
for I in Pic.End_Float .. Position loop -- May be null range.
if Answer (I) = '9' then
Answer (I) := '0';
elsif Answer (I) = '_' then
Answer (I) := Separator_Character;
elsif Answer (I) = 'b' then
Answer (I) := '*';
end if;
end loop;
if Position > Pic.End_Float then
Position := Pic.End_Float;
end if;
for I in Pic.Start_Float .. Position loop
Answer (I) := '*';
end loop;
else
if Pic.Floater = '#' then
Currency_Pos := Currency_Symbol'Length;
end if;
for I in reverse Pic.Start_Float .. Position loop
case Answer (I) is
when '*' =>
Answer (I) := Fill_Character;
when 'Z' | 'b' | '/' | '0' =>
Answer (I) := ' ';
when '9' =>
Answer (I) := '0';
when '.' | 'V' | 'v' | '<' | '$' | '+' | '-' =>
null;
when '#' =>
if Currency_Pos = 0 then
Answer (I) := ' ';
else
Answer (I) := Currency_Symbol (Currency_Pos);
Currency_Pos := Currency_Pos - 1;
end if;
when '_' =>
case Pic.Floater is
when '*' =>
Answer (I) := Fill_Character;
when 'Z' | 'b' =>
Answer (I) := ' ';
when '#' =>
if Currency_Pos = 0 then
Answer (I) := ' ';
else
Answer (I) := Currency_Symbol (Currency_Pos);
Currency_Pos := Currency_Pos - 1;
end if;
when others =>
null;
end case;
when others =>
null;
end case;
end loop;
if Pic.Floater = '#' and then Currency_Pos /= 0 then
raise Picture_Error;
end if;
end if;
-- do sign
if Sign_Position = Invalid_Position then
if Attrs.Negative then
raise Picture_Error;
end if;
else
if Attrs.Negative then
case Answer (Sign_Position) is
when 'C' | 'D' | '-' =>
null;
when '+' =>
Answer (Sign_Position) := '-';
when '<' =>
Answer (Sign_Position) := '(';
Answer (Pic.Second_Sign) := ')';
when others =>
raise Picture_Error;
end case;
else -- positive
case Answer (Sign_Position) is
when '-' =>
Answer (Sign_Position) := ' ';
when '<' | 'C' | 'D' =>
Answer (Sign_Position) := ' ';
Answer (Pic.Second_Sign) := ' ';
when '+' =>
null;
when others =>
raise Picture_Error;
end case;
end if;
end if;
-- fill in trailing digits
if Pic.Max_Trailing_Digits > 0 then
if Attrs.Has_Fraction then
Position := Attrs.Start_Of_Fraction;
Last := Pic.Radix_Position + 1;
for I in Last .. Answer'Last loop
if Answer (I) = '9' or Answer (I) = Pic.Floater then
Answer (I) := Number (Position);
if Number (Position) /= '0' then
Zero := False;
end if;
Position := Position + 1;
Last := I + 1;
exit when Position > Attrs.End_Of_Fraction;
-- Used up fraction but remember place in Answer
elsif Answer (I) = 'b' then
Answer (I) := ' ';
elsif Answer (I) = '_' then
Answer (I) := Separator_Character;
end if;
Last := I + 1;
end loop;
Position := Last;
else
Position := Pic.Radix_Position + 1;
end if;
-- now fill remaining 9's with zeros and _ with separators
Last := Answer'Last;
for I in Position .. Last loop
if Answer (I) = '9' then
Answer (I) := '0';
elsif Answer (I) = Pic.Floater then
Answer (I) := '0';
elsif Answer (I) = '_' then
Answer (I) := Separator_Character;
elsif Answer (I) = 'b' then
Answer (I) := ' ';
end if;
end loop;
Position := Last + 1;
else
if Pic.Floater = '#' and then
Currency_Pos <= Currency_Symbol'Length then
raise Picture_Error;
end if;
-- No trailing digits, but now I may need to stick in a currency
-- symbol or sign.
if Pic.Start_Currency = Invalid_Position then
Position := Answer'Last + 1;
else
Position := Pic.Start_Currency;
end if;
end if;
for I in Position .. Answer'Last loop
if Pic.Start_Currency /= Invalid_Position and then
Answer (Pic.Start_Currency) = '#' then
Currency_Pos := 1;
end if;
case Answer (I) is
when '*' =>
Answer (I) := Fill_Character;
when 'b' =>
Answer (I) := ' ';
when '#' =>
if Currency_Pos > Currency_Symbol'Length then
Answer (I) := ' ';
else
Answer (I) := Currency_Symbol (Currency_Pos);
Currency_Pos := Currency_Pos + 1;
end if;
when '_' =>
case Pic.Floater is
when '*' =>
Answer (I) := Fill_Character;
when 'Z' | 'z' =>
Answer (I) := ' ';
when '#' =>
if Currency_Pos > Currency_Symbol'Length then
Answer (I) := ' ';
else
Answer (I) := Currency_Symbol (Currency_Pos);
Currency_Pos := Currency_Pos + 1;
end if;
when others =>
null;
end case;
when others =>
exit;
end case;
end loop;
-- now get rid of Blank_when_Zero and complete Star fill.
if Zero and Pic.Blank_When_Zero then -- value is zero, and blank it.
Last := Answer'Last;
if Dollar then
Last := Last - 1 + Currency_Symbol'Length;
end if;
if Pic.Radix_Position /= Invalid_Position and then
Answer (Pic.Radix_Position) = 'V' then
Last := Last - 1;
end if;
return String' (1 .. Last => ' ');
elsif Zero and Pic.Star_Fill then
Last := Answer'Last;
if Dollar then
Last := Last - 1 + Currency_Symbol'Length;
end if;
if Pic.Radix_Position /= Invalid_Position then
if Answer (Pic.Radix_Position) = 'V' then
Last := Last - 1;
elsif Dollar then
if Pic.Radix_Position > Pic.Start_Currency then
return String' (1 .. Pic.Radix_Position - 1 => '*') &
Radix_Point &
String' (Pic.Radix_Position + 1 .. Last => '*');
else
return
String'
(1 ..
Pic.Radix_Position + Currency_Symbol'Length - 2 =>
'*') & Radix_Point &
String'
(Pic.Radix_Position + Currency_Symbol'Length .. Last
=> '*');
end if;
else
return String' (1 .. Pic.Radix_Position - 1 => '*') &
Radix_Point &
String' (Pic.Radix_Position + 1 .. Last => '*');
end if;
end if;
return String' (1 .. Last => '*');
end if;
-- This was once a simple return statement, now there are nine different
-- return cases. Not to mention the five above to deal with zeros.
-- Why no split things out?
-- Processing the radix and sign expansion separately
-- would require lots of copying--the string and some of its
-- indicies--without really simplifying the logic. The cases are:
-- 1) Expand $, replace '.' with Radix_Point
-- 2) No currency expansion, replace '.' with Radix_Point
-- 3) Expand $, radix blanked
-- 4) No currency expansion, radix blanked
-- 5) Elide V
-- 6) Expand $, Elide V
-- 7) Elide V, Expand $ (Two cases depending on order.)
-- 8) No radix, expand $
-- 9) No radix, no currency expansion
if Pic.Radix_Position /= Invalid_Position then
if Answer (Pic.Radix_Position) = '.' then
Answer (Pic.Radix_Position) := Radix_Point;
if Dollar then
return Answer (1 .. Currency_Pos - 1) & Currency_Symbol &
Answer (Currency_Pos + 1 .. Answer'Last);
-- 1) Expand $, replace '.' with Radix_Point
else
return Answer;
-- 2) No currency expansion, replace '.' with Radix_Point
end if;
elsif Answer (Pic.Radix_Position) = ' ' then -- blanked radix.
if Dollar then
return Answer (1 .. Currency_Pos - 1) & Currency_Symbol &
Answer (Currency_Pos + 1 .. Answer'Last);
-- 3) Expand $, radix blanked
else
return Answer;
-- 4) No expansion, radix blanked
end if;
else -- V cases...
if not Dollar then
return Answer (1 .. Pic.Radix_Position - 1) &
Answer (Pic.Radix_Position + 1 .. Answer'Last);
-- 5) Elide V
elsif Currency_Pos < Pic.Radix_Position then
return Answer (1 .. Currency_Pos - 1) & Currency_Symbol &
Answer (Currency_Pos + 1 .. Pic.Radix_Position - 1) &
Answer (Pic.Radix_Position + 1 .. Answer'Last);
-- 6) Expand $, Elide V
else
return Answer (1 .. Pic.Radix_Position - 1) &
Answer (Pic.Radix_Position + 1 .. Currency_Pos - 1) &
Currency_Symbol &
Answer (Currency_Pos + 1 .. Answer'Last);
-- 7) Elide V, Expand $
end if;
end if;
elsif Dollar then
return Answer (1 .. Currency_Pos - 1) & Currency_Symbol &
Answer (Currency_Pos + 1 .. Answer'Last);
-- 8) No radix, expand $
else
return Answer;
-- 9) No radix, no currency expansion
end if;
end Format_Number;
function Expand (Picture : in String) return String is
Result : String (1 .. MAX_PICSIZE);
Picture_Index : Integer := Picture'First;
Result_Index : Integer := Result'First;
Count : Natural;
Last : Integer;
package Int_IO is new Text_IO.Integer_IO (Integer);
begin
if Picture'Length < 1 then raise Picture_Error; end if;
if Picture (Picture'First) = '(' then raise Picture_Error; end if;
loop
case Picture (Picture_Index) is
when '(' =>
Int_IO.Get (Picture (Picture_Index + 1 .. Picture'Last),
Count, Last);
if Picture (Last + 1) /= ')' then raise Picture_Error; end if;
-- In what follows note that one copy of the repeated
-- character has already been made, so a count of one is a
-- no-op, and a count of zero erases a character.
for I in 2 .. Count loop
Result (Result_Index + I - 2) := Picture (Picture_Index - 1);
end loop;
Result_Index := Result_Index + Count - 1;
Picture_Index := Last + 2;
-- Last + 1 was a ')' throw it away too.
when ')' => raise Picture_Error;
when others =>
Result (Result_Index) := Picture (Picture_Index);
Picture_Index := Picture_Index + 1;
Result_Index := Result_Index + 1;
end case;
exit when Picture_Index > Picture'Last;
end loop;
return Result (1 .. Result_Index - 1);
exception
when others => raise Picture_Error;
end Expand;
package Strings renames Ada.Strings;
package Strings_Fixed renames Ada.Strings.Fixed;
package Text_IO renames Ada.Text_IO;
function Valid
(Pic_String : in String;
Blank_When_Zero : in Boolean := False)
return Boolean is
begin
declare
Expanded_Pic : constant String := Expand (Pic_String);
-- Raises Picture_Error if Item not well-formed
begin
return not Blank_When_Zero or
Strings_Fixed.Index (Expanded_Pic, "*") = 0;
-- False only if Blank_When_0 is True but the pic string
-- has a '*'
end;
exception
when others =>
return False;
end Valid;
function To_Picture
(Pic_String : in String;
Blank_When_Zero : in Boolean := False)
return Picture is
Result : Picture;
begin
declare
Item : constant String := Expand (Pic_String);
begin
Result.Contents.Picture := (Item'Length, Item);
Result.Contents.Blank_When_Zero := Blank_When_Zero;
Precalculate (Result.Contents);
return Result;
end;
exception
when others =>
raise Picture_Error;
end To_Picture;
function Pic_String (Pic : in Picture) return String is
begin
return Pic.Contents.Picture.Expanded;
end Pic_String;
function Blank_When_Zero (Pic : in Picture) return Boolean is
begin
return Pic.Contents.Blank_When_Zero;
end Blank_When_Zero;
package body Decimal_Output is
function Length (Pic : in Picture;
Currency : in String := Default_Currency)
return Natural is
Picstr : constant String := Pic_String (Pic);
V_Adjust : Integer := 0;
Cur_Adjust : Integer := 0;
begin
-- Check if Picstr has 'V' or '$'
-- If 'V', then length is 1 less than otherwise
-- If '$', then length is Currency'Length-1 more than otherwise
-- <<TBD>> This should use the string handling package
for I in Picstr'Range loop
if Picstr (I) = 'V' then
V_Adjust := -1;
elsif Picstr (I) = '$' then
Cur_Adjust := Currency'Length - 1;
end if;
end loop;
return Picstr'Length - V_Adjust + Cur_Adjust;
end Length;
-- Valid doesn't use at all Item ???
function Valid (Item : Num;
Pic : in Picture;
Currency : in String := Default_Currency)
return Boolean is
Start_Currency : constant Integer := Pic.Contents.Start_Currency;
End_Currency : constant Integer := Pic.Contents.End_Currency;
begin
if Start_Currency = Invalid_Position then
-- no currency symbol in pic string, hence pic OK
return True;
elsif Pic.Contents.Picture.Expanded (Start_Currency) = '#'
and Currency'Length > End_Currency - Start_Currency + 1 then
return False;
else
return True;
end if;
end Valid;
function Image (Item : in Num;
Pic : in Picture;
Currency : in String := Default_Currency;
Fill : in Character := Default_Fill;
Separator : in Character := Default_Separator;
Radix_Mark : in Character := Default_Radix_Mark)
return String is
begin
return Format_Number
(Pic.Contents, Num'Image (Item),
Currency, Fill, Separator, Radix_Mark);
end Image;
procedure Put (File : in Text_IO.File_Type;
Item : in Num;
Pic : in Picture;
Currency : in String := Default_Currency;
Fill : in Character := Default_Fill;
Separator : in Character := Default_Separator;
Radix_Mark : in Character := Default_Radix_Mark) is
begin
Text_IO.Put (File, Image (Item, Pic,
Currency, Fill, Separator, Radix_Mark));
end Put;
procedure Put (Item : in Num;
Pic : in Picture;
Currency : in String := Default_Currency;
Fill : in Character := Default_Fill;
Separator : in Character := Default_Separator;
Radix_Mark : in Character := Default_Radix_Mark) is
begin
Text_IO.Put (Image (Item, Pic,
Currency, Fill, Separator, Radix_Mark));
end Put;
procedure Put (To : out String;
Item : in Num;
Pic : in Picture;
Currency : in String := Default_Currency;
Fill : in Character := Default_Fill;
Separator : in Character := Default_Separator;
Radix_Mark : in Character := Default_Radix_Mark) is
Result : constant String :=
Image (Item, Pic, Currency, Fill, Separator, Radix_Mark);
begin
if Result'Length > To'Length then
raise Text_IO.Layout_Error;
else
Strings_Fixed.Move (Source => Result, Target => To,
Justify => Strings.Right);
end if;
end Put;
end Decimal_Output;
end Ada.Text_IO.Editing;
